#lang racket

(require racket/match)

(require "utilities.scm")
(require "box.scm")
(require "environment.scm")
(require "syntax-object.scm")

;;(require "debug.scm")

(provide interpret-program
         interpret-exp)

;;; interpreter
;;

(define (interpret-program prg env)
  (if (null? prg)
      #t
      (match (car prg)
	((list (syx 'id 'define meta-1) (syx 'id name meta-2) exp)
	 (update-env! env (make-binding name (interpret-exp exp env)))
	 (interpret-program (cdr prg) env))
        ((syx 'atomic x y)
         (interpret-program (cdr prg) env)))))

(define (interpret-exp exp env)
  ;;(print `(int ,exp))
  (cond ((syx-atomic? exp) (syx-data exp))
	((syx-id? exp) (env-ref (syx-id exp) env))
	((null? exp) '())
	((and (pair? exp) (syx-special? (car exp)))
	 (interpret-special exp env))
	((pair? exp)
	 (apply (interpret-exp (car exp) env)
		(map (lambda (e) (interpret-exp e env)) (cdr exp))))
	(else (error "interpret-exp: unknown syntax" exp))))

(define (interpret-special exp env)
  (match exp

    ((list (syx 'special 'lambda meta) params body)
     (let ((param-names (map syx-id params)))
       (lambda args
	 (let ((env (extend-env* env (map make-binding param-names args))))
	   (interpret-exp body env)))))

    ((list* (syx 'special 'begin meta) stmts)
     (let loop ((stmts stmts))
       (if (null? (cdr stmts))
	   (interpret-exp (car stmts) env)
	   (begin
	     (interpret-exp (car stmts) env)
	     (loop (cdr stmts))))))

    ((list (syx 'special 'if meta) t c a)
     (if (interpret-exp t env)
	 (interpret-exp c env)
	 (interpret-exp a env)))

    ((list (syx 'special 'quote meta) d)
     d)

    ((list (syx 'special 'let meta) bindings body)
     ;; evaluate each binding
     ;; add them to the env
     ;; evaluate the body
     (let ((bindings^ (map (lambda (entry)
                             (make-binding (syx-id (car entry)) (interpret-exp (cadr entry) env)))
                           bindings)))
       (interpret-exp body (extend-env* env bindings^))))

    ((list (syx 'special 'letrec meta) bindings body)
     ;; extend the env with #f's
     ;; evaluate each binding, updating the env
     ;; evaluate the body
     (let ((scope-extension (map (lambda (entry) (make-binding (syx-id (car entry)) #f)) bindings)))
       (extend-env* env scope-extension)
       (let loop ((bindings bindings))
         (if (null? bindings)
             (interpret-exp body env)
             (let ((entry (car bindings)))
               (begin
                 (update-env! env (make-binding (syx-id (car entry)) (interpret-exp (cadr entry) env)))
                 (loop (cdr bindings))))))))

    (else (error "invalid syntax in interpret special" exp))))
